        PROGRAM IDEAL2
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
C	PROGRAM TO GENERATE IDEAL P1 REFERENCE DATA SET FOR CALCULATING
C	THEORETICAL POINT SPREAD FUNCTION TO GIVEN RESOLUTION AND GIVEN 
C	MAXIMUM TILT
C	WRITE H K Z* AMP=1 PHASE=0 FOM=100
C       L   RANGE CURRENTLY  L=100 for 00L lattice line 
C     
C       COMPARED TO JOYCE'S JIFFY THIS WRITES OUT THE UNIQUE HALF OF A FULL
C	SPHERE, INCLUDING NEGATIVE L-INDICES (THE ORIGINAL FROM JOYCE GENERATES
C	THE UNIQUE REFLECTIONS + THE FRIEDEL MATES BUT ONLY WRITES POSITIVE L
C	FOR EACH LATTICE LINE).
C   
C       card 1     TITLE
C	card 2     RESOLUTION, TILTANGLE
C	card 3	   CELLA,CELLB,GAMMA,CAXIS
C       card 4     IHSCR,IKSCR
C       card 5     INDEXMAX
C
C	TITLE	  	 DATA SET NUMBER WRITTEN ON TOP OF DATA LIST
C	RESOLUTION	 MAXIMUM RESOLUTION TO WHICH REFERENCE DATA SET
C			 WILL BE CALCULATED
C	TITLANGLE	 MAXIMUM TITLANGLE USED FOR CALCULATING DATA
C	CELLA,CELLB..	 REAL SPACE UNIT CELL DIMENSIONS
C	IHSCR,IKSCR	 IF =F, NO SYSTEMATIC ABSENCES CAUSED BY SCREWAXES
C			 IF =T  REFLECTIONS WITH ODD INDEX ALONG AXIS WILL
C				BE REJECTED
C       INDEXMAX         SPECIFIES MAXIMUM H,K USED FOR GENERATING REFLECTIONS
C                        FOR NOW, H AND K HAVE SAME MAXIMUM LIMIT SPECIFIED
C                        IN COMMANDFILE
C
C COMPILE: f77 -extend_source -w -o ideal2 ideal2.f ${IMAGELIB}/genlib.a
C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
C     
      CHARACTER TITLE(80)
      PARAMETER (ILM=100)
      LOGICAL IHSCR
      LOGICAL IKSCR
C
C
      WRITE(6,49)
49    FORMAT(/,/,' IDEAL2 (22.7.2000) - program to generate',/,
     . ' ideal data set for given max tilt and resolution to be used',/,
     . ' in calculation of reference point-spread function')

      DEGTORAD=3.1415962/180.0
      READ(5,'(80A)')TITLE
      READ(5,*)RESOLUTION,TILTANGLE 
      TILT=TILTANGLE*DEGTORAD
      TANTILT=TAN(TILT)
      READ(5,*)CELLA,CELLB,GAMMA,CAXIS
      READ(5,*)IHSCR,IKSCR
      READ(5,*)INDEXMAX
      WRITE(6,50)CELLA,CELLB,GAMMA,CAXIS,TILTANGLE,RESOLUTION,INDEXMAX
50    FORMAT('            a-axis cell dimension =============',F6.2,/,
     .       '            b-axis cell dimension =============',F6.2,/,
     .       '            gamma angle =======================',F6.2,/,
     .	     '            c-axis cell dimension =============',F6.2,/,
     .       '            Tilt angle ========================',F6.2,/,
     .       '            Resolution ========================',F6.2,/,
     .       '            maximum h and k index==============',I4)
C
C
      ASTAR=1.0/(CELLA*SIN(GAMMA*DEGTORAD))
      BSTAR=1.0/(CELLB*SIN(GAMMA*DEGTORAD)) 
      CSTAR=1.0/CAXIS
      GAMMAST=180-GAMMA
C
      NOUT=0
      A=1.0
      P=0.0
      FOM=100
C
C
      CALL CCPDPN(2,'OUT','UNKNOWN','F', 0, 0)
      WRITE(2,'(X,80A)') TITLE
C
      IF(TILTANGLE.GT.89) THEN
C      INCLUDE 00L
      IH=0
      IK=0
      ZLIM=ILM*CSTAR
      ZSTMAX=ZLIM
      ZSTLIMHK=ZLIM
      WRITE(6,13)IH,IK,ILM,ZLIM,ZSTMAX,ZSTLIMHK
      DO 9  IL=1,ILM
      NOUT=NOUT+1
C      ZSTAR=IL*CSTAR
      WRITE(2,25)IH,IK,IL,A,P,FOM
9     CONTINUE
      ENDIF
C
       
C     CHECK THAT INDEXMAX IS NOT LIMITING
      RSQKM=INDEXMAX**2*ASTAR**2+INDEXMAX**2*BSTAR**2+
     .		2.0*INDEXMAX**2*ASTAR*BSTAR*COS(GAMMAST*DEGTORAD)
      RHKM=SQRT(1/RSQKM)
      IF (RHKM.GE.RESOLUTION) THEN
      WRITE(6,51)RESOLUTION,RHKM
51    FORMAT('::ERROR: MAXIMUM H AND/OR K DO NOT PERMIT TO REACH REQUESTED RESOLUTION',/,
     .	       ':: REQUESTED:',F8.2,' CURRENT LIMIT:',F8.2)
      STOP
      ENDIF
      DO 10 IH=-INDEXMAX,INDEXMAX
      DO 11 IK=0,INDEXMAX
      RSQ=IH**2*ASTAR**2+IK**2*BSTAR**2+
     .		2.0*IH*IK*ASTAR*BSTAR*COS(GAMMAST*DEGTORAD)
      IF(RSQ.GT.1.0/RESOLUTION**2) GOTO 11
      ZSTMAXSQ=(1.0/RESOLUTION**2)-RSQ
      ZSTMAX=SQRT(ZSTMAXSQ)
      RHK=SQRT(RSQ)
      IF(TILTANGLE.GT.89.0) GOTO 15
      ZSTLIMHK=RHK*TANTILT
      IF(ZSTLIMHK.LT.ZSTMAX)ZLIM=ZSTLIMHK
      IF(ZSTLIMHK.GE.ZSTMAX)ZLIM=ZSTMAX
      GO TO 16
15    ZLIM=ZSTMAX
16    ILMAX=NINT(ZLIM*CAXIS)
      WRITE(6,13)IH,IK,ILMAX,ZLIM,ZSTMAX,ZSTLIMHK
13    FORMAT(' FOR LINE',2I5,' MAXL',I5,3F10.5)
C
      DO 12 IL=-ILMAX,ILMAX
C     ZSTAR=IL*CSTAR
C
C     SKIP (0,0,0)
      IF(IH.EQ.0.AND.IK.EQ.0.AND.IL.EQ.0) GOTO 12
C
C     SKIP WRITING OUT (-H,0,0) AND (H,0,0)
      IF(IH.LT.0.AND.IK.EQ.0) GOTO 12
C
C     SKIP ODD (0,K,0) AND ODD (H,0,0) REFLECTIONS IF THESE ARE
C     IMAGINARY 
      K2=IH/2
      K3=IK/2
      IF(IHSCR) THEN
	      IF(IH.NE.2*K2.AND.IL.EQ.0.AND.IK.EQ.0) GOTO 12
      ENDIF
      IF(IKSCR) THEN
	      IF(IK.NE.2*K3.AND.IL.EQ.0.AND.IH.EQ.0) GOTO 12
      ENDIF	 
      WRITE(2,25)IH,IK,IL,A,P,FOM
      NOUT=NOUT+1
25    FORMAT(3I5,3F13.4)
12    CONTINUE
11    CONTINUE
10    CONTINUE
      WRITE(6,56)NOUT
56    FORMAT(': POINT RESPONSE DATA FILE COMPLETED',/,
     .	':',I10,' terms written out')
      STOP
      END
